home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / SYSTEMER.I < prev    next >
Encoding:
Modula Implementation  |  1994-01-17  |  3.0 KB  |  134 lines
  1. IMPLEMENTATION MODULE SystemError;
  2. (*$M-,N+,L-*)
  3.  
  4. (*
  5.  * 06.11.90: AbortWithMsg wird mit ADDRESS statt ARRAY OF CHAR-Parm
  6.  * 17.01.94: TermProcess-Aufruf statt direktem Pterm
  7.  *)
  8.  
  9. (*$Y+*)
  10. FROM SYSTEM IMPORT ASSEMBLER;
  11. FROM SYSTEM IMPORT ADDRESS;
  12. FROM PrgCtrl IMPORT TermProcess;
  13.  
  14. (*
  15. PROCEDURE alert;
  16.   BEGIN
  17.     ASSEMBLER
  18.         LEA     Data(PC),A1
  19.         LEA     24(A1),A2
  20.         MOVE.L  A0,(A2)
  21.         MOVE.L  A2,16(A1)
  22.         ADDQ    #4,A2
  23.         MOVE.L  A2,8(A1)
  24.         MOVE    #1,(A2)+        ; Default Button-Nr.
  25.         MOVE.L  A2,12(A1)
  26.         ADDQ    #2,A2
  27.         MOVE.L  A2,4(A1)
  28.         LEA     Control(PC),A0
  29.         MOVE.L  A0,(A1)
  30.         CLR.L   10(A2)
  31.         MOVE.L  A1,D1
  32.         MOVE    #$C8,D0
  33.         TRAP    #2
  34.         RTS
  35.  
  36. Control DC.W    52,1,1,1,0,0
  37. Data    DS      52
  38.     END
  39.   END alert;
  40. *)
  41.  
  42. (*
  43. PROCEDURE Terminate (msg: ADDRESS);
  44.   BEGIN
  45.     ASSEMBLER
  46.         MOVE.L  -(A3),A0        ; msg
  47.         JSR     alert
  48.         MOVE    #-1,(A3)+
  49.         JMP     TermProcess
  50.     END
  51.   END Terminate;
  52.  
  53. PROCEDURE OutOfMemory;
  54.   BEGIN
  55.     ASSEMBLER
  56.         LEA     msg(PC),A0
  57.         JSR     alert
  58.         MOVE    #-39,(A3)+
  59.         JMP     TermProcess
  60.       msg:
  61.         ASC     '[3][Out of memory][ BYE ]'
  62.     END
  63.   END OutOfMemory;
  64. *)
  65.  
  66. PROCEDURE Abort (no: INTEGER);
  67.   BEGIN
  68.     ASSEMBLER
  69.         MOVE    -(A3),D0
  70.         BPL     ok
  71.         CMPI    #-32,D0
  72.         BGE     ret1
  73.         CMPI    #-95,D0
  74.         BGT     ok
  75.         MOVEQ   #-93,D0         ; für no < -94
  76.         BRA     ok
  77.       ret1
  78.         SUBI.W  #62,D0          ; für no zw. -1..-32 -> TOS-Error #32 - #63
  79.      ok ; -63 ergibt "TOS-Error #32"
  80.         ; -31 wäre demnach "TOS-Error #0"
  81.         ; angezeigt werden alle Werte von -33 bis -94
  82.         MOVE    D0,(A3)+
  83.         JMP     TermProcess
  84.     END
  85.   END Abort;
  86.  
  87. PROCEDURE AbortWithMsg (msg: ADDRESS);
  88.   BEGIN
  89.     ASSEMBLER
  90.         PEA     T1(PC)
  91.         MOVE    #9,-(A7)        ;Cconws
  92.         TRAP    #1
  93.         ADDQ.L  #6,A7
  94.         MOVE.L  -(A3),-(A7)
  95.         BEQ     noText
  96.         (* Für ARRAY OF CHAR-Par:
  97.           MOVE    D0,D1
  98.           ADDQ    #3,D1
  99.           BCLR    #0,D1
  100.           SUBA.W  D1,A7
  101.           MOVE.L  A7,A1
  102.         L MOVE.B  (A0)+,(A1)+     ; msg auf Stack kopieren
  103.           DBEQ    D0,L
  104.           CLR.B   (A1)+           ; und Null-terminieren
  105.           MOVE.L  A7,-(A7)
  106.         *)
  107.         MOVE    #9,-(A7)        ;Cconws
  108.         TRAP    #1
  109.         ADDQ.L  #6,A7
  110.       noText
  111.         PEA     T2(PC)
  112.         MOVE    #9,-(A7)        ;Cconws
  113.         TRAP    #1
  114.         MOVE    #-1,(A3)+
  115.         JMP     TermProcess
  116.      T1 DC.B    13,10
  117.         ACZ     'Fatal error: '
  118.      T2 DC.B    13,10
  119.         ASC     'Program aborted!'
  120.         DC.B    13,10,0
  121.         SYNC
  122.     END
  123.   END AbortWithMsg;
  124.  
  125. PROCEDURE OutOfMemory;
  126.   BEGIN
  127.     ASSEMBLER
  128.         MOVE    #-39,(A3)+
  129.         JMP     TermProcess
  130.     END
  131.   END OutOfMemory;
  132.  
  133. END SystemError.
  134.